org_df <- read_excel("wuhan_blood_sample_data_Jan_Feb_2020.xlsx")

Data cleaning

The following steps were undertaken to clean the original dataset:
df <- org_df %>% 
        mutate(gender = as.factor(ifelse(gender==1, "male", "female"))) %>%
        mutate(outcome = as.factor(ifelse(outcome == 0, "survived", "died"))) %>%
        rename(admission_time = 'Admission time',
               discharge_time = 'Discharge time')

The dataset was split into two dataframes in order to make data analysis easier.

Patients

One additional column was created to store the hospitalization time of all patients - used in further analysis to check the relation between length stay and outcome.

patients <- df %>% 
              select(PATIENT_ID, age, gender, admission_time, discharge_time, outcome) %>% 
              drop_na(PATIENT_ID) %>%
              mutate("hospitalization_length" = round((difftime(discharge_time, admission_time, units = "days") ), digits = 2)) %>%
              relocate(hospitalization_length, .after = discharge_time)

head(patients) %>%
  kbl() %>%
  kable_paper("hover")
PATIENT_ID age gender admission_time discharge_time hospitalization_length outcome
1 73 male 2020-01-30 22:12:47 2020-02-17 12:40:09 17.60 days survived
2 61 male 2020-02-04 21:39:03 2020-02-19 12:59:01 14.64 days survived
3 70 female 2020-01-23 10:59:36 2020-02-08 17:52:31 16.29 days survived
4 74 male 2020-01-31 23:03:59 2020-02-18 12:59:12 17.58 days survived
5 29 female 2020-02-01 20:59:54 2020-02-18 10:33:06 16.56 days survived
6 81 female 2020-01-24 10:47:10 2020-02-07 09:06:58 13.93 days survived

Blood tests

blood_tests_df <- df %>%
  select(-c(admission_time, discharge_time)) %>%
  fill(PATIENT_ID)

blood_tests_df %>% select (-PATIENT_ID) %>%
                   tbl_summary(by = outcome, missing = "no", statistic = list(all_continuous() ~ "{mean} ({sd})")) %>%
                   modify_header(label = "**Variable**")
## Column(s) 'RE_DATE' omitted from output.
## Accepted classes are 'character', 'factor', 'numeric', 'logical', 'integer', or 'difftime'.
Variable died, N = 2,9051 survived, N = 3,2151
age 70 (11) 50 (15)
gender
female 751 (26%) 1,639 (51%)
male 2,154 (74%) 1,576 (49%)
Hypersensitive cardiac troponinI 1,856 (6,568) 12 (49)
hemoglobin 122 (24) 124 (24)
Serum chloride 106 (10) 101 (4)
Prothrombin time 19.0 (12.1) 13.7 (0.9)
procalcitonin 2.17 (6.51) 0.09 (0.29)
eosinophils(%) 0.15 (0.38) 1.07 (1.29)
Interleukin 2 receptor 1,383 (1,020) 620 (388)
Alkaline phosphatase 99 (51) 66 (35)
albumin 28 (5) 36 (4)
basophil(%) 0.15 (0.14) 0.27 (0.25)
Interleukin 10 30 (111) 8 (5)
Total bilirubin 24 (36) 10 (5)
Platelet count 126 (87) 239 (88)
monocytes(%) 3.9 (3.2) 8.3 (3.6)
antithrombin 81 (19) 95 (13)
Interleukin 8 186 (893) 21 (36)
indirect bilirubin 8.0 (9.2) 5.8 (3.4)
Red blood cell distribution width 13.75 (2.04) 12.42 (0.99)
neutrophils(%) 90 (8) 66 (14)
total protein 62 (8) 69 (5)
Quantification of Treponema pallidum antibodies 0.19 (1.08) 0.09 (0.33)
Prothrombin activity 66 (20) 95 (12)
HBsAg 15.31 (58.32) 2.28 (20.93)
mean corpuscular volume 91.4 (7.3) 89.5 (5.5)
hematocrit 36.0 (6.2) 37.1 (4.3)
White blood cell count 16 (32) 16 (87)
Tumor necrosis factorα 17 (20) 8 (4)
mean corpuscular hemoglobin concentration 342 (19) 344 (16)
fibrinogen 4.14 (2.22) 4.51 (1.29)
Interleukin 1β 7.1 (9.3) 6.2 (5.2)
Urea 14 (11) 5 (4)
lymphocyte count 0.53 (0.34) 1.47 (2.77)
PH value 6.55 (0.81) 6.43 (0.64)
Red blood cell count 12.4 (46.7) 6.7 (24.3)
Eosinophil count 0.02 (0.05) 0.06 (0.07)
Corrected calcium 2.35 (0.14) 2.36 (0.12)
Serum potassium 4.71 (1.02) 4.29 (0.55)
glucose 11.0 (6.0) 6.9 (3.3)
neutrophils count 11.6 (6.4) 4.3 (2.7)
Direct bilirubin 16 (29) 4 (2)
Mean platelet volume 11.47 (1.11) 10.48 (0.86)
ferritin 2,876 (5,672) 635 (552)
RBC distribution width SD 44.9 (7.5) 40.0 (3.5)
Thrombin time 19.38 (11.50) 16.52 (1.33)
(%)lymphocyte 6 (5) 24 (11)
HCV antibody quantification 0.16 (0.32) 0.08 (0.10)
D-D dimer 13 (9) 1 (3)
Total cholesterol 3.36 (0.96) 4.00 (0.90)
aspartate aminotransferase 69 (143) 25 (15)
Uric acid 293 (189) 259 (97)
HCO3- 21.7 (5.0) 24.7 (3.0)
calcium 1.99 (0.15) 2.17 (0.11)
Amino-terminal brain natriuretic peptide precursor(NT-proBNP) 5,037 (10,809) 874 (6,004)
Lactate dehydrogenase 707 (400) 247 (95)
platelet large cell ratio 36 (9) 28 (7)
Interleukin 6 270 (865) 21 (36)
Fibrin degradation products 90 (64) 6 (13)
monocytes count 0.43 (0.32) 0.61 (2.33)
PLT distribution width 14.32 (3.17) 12.01 (1.95)
globulin 34.2 (6.1) 32.3 (4.7)
γ-glutamyl transpeptidase 71 (81) 40 (52)
International standard ratio 1.52 (1.03) 1.04 (0.08)
basophil count(#) 0.019 (0.018) 0.015 (0.016)
2019-nCoV nucleic acid detection
-1 57 (100%) 444 (100%)
mean corpuscular hemoglobin 31.24 (3.10) 30.77 (2.70)
Activation of partial thromboplastin time 43 (14) 39 (6)
High sensitivity C-reactive protein 131 (79) 25 (38)
HIV antibody quantification 0.10 (0.05) 0.10 (0.03)
serum sodium 144 (9) 139 (3)
thrombocytocrit 0.16 (0.08) 0.25 (0.08)
ESR 39 (27) 30 (22)
glutamic-pyruvic transaminase 47 (116) 31 (28)
eGFR 66 (31) 97 (24)
creatinine 133 (121) 87 (143)

1 Statistics presented: Mean (SD); n (%)

ggplot(patients, aes(x = gender, fill = gender)) +
  geom_bar() + 
  labs(title= "Numer of patients per gender hospitilized in Tongji Hospital (Wuhan) ", 
       subtitle = "between 10 January and 18 February 2020",
       y = "Number of patients", 
       x = "Gender")

Visualization

Patients grouped by gender

patients_hist <- ggplot(patients, aes(x = age, fill = gender)) +
  geom_histogram(stat = "count",
                 binwidth = 1.2)+
  labs(y = "Number of patients", 
       x = "Age") +
  scale_x_continuous(breaks=seq(20, 100, 5))
## Warning: Ignoring unknown parameters: binwidth, bins, pad
ggplotly(patients_hist)      

Outcome grouped by gender, age

patients_outcome <- ggplot(patients, aes(x = age, fill = outcome)) + 
                    geom_histogram(binwidth = 1.2) +
                    facet_grid(~ gender) +
                    scale_y_continuous(breaks=seq(0, 20, 2)) +
                    scale_x_continuous(breaks=seq(20, 100, 5)) + ylab("Number of cases")

ggplotly(patients_outcome)

Outcome due to hospitalization length grouped by gender

ggplot(patients, aes(x = hospitalization_length, fill = outcome)) + 
      geom_histogram(binwidth = 1.2) +
      facet_grid(outcome ~ gender) +
      scale_y_continuous(breaks=seq(0, 20, 2)) +
      scale_x_continuous(breaks=seq(0, 40, 5)) +
      labs(y = "Number of patients", 
           x = "Hospitalization length [days]")

Outcome animation over time

# plot_anim <- patients %>% filter(gender == "male") %>% arrange(admission_time) %>% select(-c(discharge_time, hospitalization_length, PATIENT_ID)) %>% ggplot(aes(x = age, fill = outcome)) + geom_histogram()
# 
# anim <- plot_anim + transition_null() + enter_fade()
# 
# anim

Relation between outcome dead and biomarker

Może wykres facet outcome w zaleznosci od

outcome_died <- blood_tests_df %>% filter(outcome == "died")

Classification problem

blood_cut <- blood_tests_df %>% select(-c(2:6)) %>% filter(PATIENT_ID == 1) %>% kbl()
## Warning in do.call(data.frame, c(x, alis)): unable to translate 'Tumor necrosis
## factor<U+03B1>' to native encoding
## Warning in do.call(data.frame, c(x, alis)): unable to translate '<U+03B3>-
## glutamyl transpeptidase' to native encoding
blood_cut
PATIENT_ID hemoglobin Serum chloride Prothrombin time procalcitonin eosinophils(%) Interleukin 2 receptor Alkaline phosphatase albumin basophil(%) Interleukin 10 Total bilirubin Platelet count monocytes(%) antithrombin Interleukin 8 indirect bilirubin Red blood cell distribution width neutrophils(%) total protein Quantification of Treponema pallidum antibodies Prothrombin activity HBsAg mean corpuscular volume hematocrit White blood cell count Tumor necrosis factorα mean corpuscular hemoglobin concentration fibrinogen Interleukin 1β Urea lymphocyte count PH value Red blood cell count Eosinophil count Corrected calcium Serum potassium glucose neutrophils count Direct bilirubin Mean platelet volume ferritin RBC distribution width SD Thrombin time (%)lymphocyte HCV antibody quantification D-D dimer Total cholesterol aspartate aminotransferase Uric acid HCO3- calcium Amino-terminal brain natriuretic peptide precursor(NT-proBNP) Lactate dehydrogenase platelet large cell ratio Interleukin 6 Fibrin degradation products monocytes count PLT distribution width globulin γ-glutamyl transpeptidase International standard ratio basophil count(#) 2019-nCoV nucleic acid detection mean corpuscular hemoglobin Activation of partial thromboplastin time High sensitivity C-reactive protein HIV antibody quantification serum sodium thrombocytocrit ESR glutamic-pyruvic transaminase eGFR creatinine
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 7.415 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
1 136 NA NA NA 0.6 NA NA NA 0.3 NA NA 105 10.7 NA NA NA 11.9 65.8 NA NA NA NA 91.8 39.2 3.54 NA 347 NA NA NA 0.80 NA 4.27 0.02 NA NA NA 2.33 NA 11.9 NA 40.8 NA 22.6 NA NA NA NA NA NA NA NA NA 39.9 NA NA 0.38 16.3 NA NA NA 0.01 NA 31.9 NA NA NA NA 0.12 NA NA NA NA
1 NA 103.1 NA NA NA NA 46 33.3 NA NA 8.3 NA NA NA NA 4.3 NA NA 69.3 NA NA NA NA NA NA NA NA NA NA 8.5 NA NA NA NA 2.29 4.33 NA NA 4.0 NA NA NA NA NA NA NA 3.90 33 418 21.2 2.02 NA 306 NA NA NA NA NA 36.0 24 NA NA NA NA NA 43.1 NA 137.7 NA NA 16 46.6 130
1 NA NA 13.9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 91 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 2.20 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 1.06 NA NA NA NA NA NA NA NA NA NA NA NA
1 NA NA NA 0.09 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 7.35 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 60 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 41 NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.05 NA 0.03 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.06 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.09 NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3.60 NA NA NA NA NA NA 6.000 1.60 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -1 NA NA NA NA NA NA NA NA NA NA
1 140 NA NA NA 0.3 NA NA NA 0.1 NA NA 214 7.2 NA NA NA 11.6 66.5 NA NA NA NA 91.1 39.7 6.90 NA 353 NA NA NA 1.79 NA 4.36 0.02 NA NA NA 4.58 NA 10.9 NA 39.0 NA 25.9 NA NA NA NA NA NA NA NA NA 32.1 NA NA 0.50 12.6 NA NA NA 0.01 NA 32.1 NA NA NA NA 0.23 NA NA NA NA
1 NA 101.4 NA NA NA NA 54 33.2 NA NA 7.4 NA NA NA NA 4.5 NA NA 67.9 NA NA NA NA NA NA NA NA NA NA 5.0 NA NA NA NA 2.53 4.73 5.92 NA 2.9 NA NA NA NA NA NA NA 3.81 35 281 26.7 2.25 NA 250 NA NA NA NA NA 34.7 31 NA NA NA NA NA 3.6 NA 142.9 NA NA 42 72.7 90
1 130 NA NA NA 0.2 NA NA NA 0.1 NA NA 168 4.9 NA NA NA 11.9 84.3 NA NA NA NA 92.7 38.0 12.58 NA 342 NA NA NA 1.32 NA 4.10 0.02 NA NA NA 10.61 NA 10.5 NA 40.5 NA 10.5 NA NA NA NA NA NA NA NA NA 29.3 NA NA 0.62 11.9 NA NA NA 0.01 NA 31.7 NA NA NA NA 0.18 NA NA NA NA
1 NA NA 14.1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 89 NA NA NA NA NA NA 3.28 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 19.2 NA NA 0.66 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 1.08 NA NA NA 37.9 NA NA NA NA NA NA NA NA
1 NA 98.5 NA NA NA NA 57 32.4 NA NA 16.6 NA NA NA NA 11.1 NA NA 62.2 NA NA NA NA NA NA NA NA NA NA 7.6 NA NA NA NA 2.33 4.21 17.18 NA 5.5 NA NA NA NA NA NA NA 3.65 16 379 25.6 2.04 NA 200 NA NA NA NA NA 29.8 27 NA NA NA NA NA NA NA 139.4 NA NA 29 64.8 99
1 129 NA NA NA 1.1 NA NA NA 0.3 NA NA 143 9.0 NA NA NA 11.9 60.9 NA NA NA NA 93.2 36.9 9.05 NA 350 NA NA NA 2.60 NA 3.96 0.10 NA NA NA 5.51 NA 11.5 NA 40.7 NA 28.7 NA NA NA NA NA NA NA NA NA 37.2 NA NA 0.81 14.9 NA NA NA 0.03 NA 32.6 NA NA NA NA 0.16 NA NA NA NA
1 NA 98.1 NA NA NA NA 61 35.9 NA NA 9.6 NA NA NA NA 6.0 NA NA 67.2 NA NA NA NA NA NA NA NA NA NA 6.9 NA NA NA NA 2.47 4.61 NA NA 3.6 NA NA NA NA NA NA NA 4.62 21 388 31.0 2.25 NA 198 NA NA NA NA NA 31.3 42 NA NA NA NA NA 2.6 NA 140.0 NA NA 29 74.7 88
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 6.44 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -1 NA NA NA NA NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -1 NA NA NA NA NA NA NA NA NA NA
1 131 NA NA NA 1.7 NA NA NA 0.2 NA NA 141 7.9 NA NA NA 11.9 64.3 NA NA NA NA 93.8 38.0 9.67 NA 345 NA NA NA 2.50 NA 4.05 0.16 NA NA NA 6.23 NA 11.3 NA 41.5 NA 25.9 NA NA NA NA NA NA NA NA NA 36.9 NA NA 0.76 14.3 NA NA NA 0.02 NA 32.3 NA NA NA NA 0.16 NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 6.75 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
1 NA 100.0 NA NA NA NA 71 37.6 NA NA 6.3 NA NA NA NA 3.7 NA NA 67.7 NA NA NA NA NA NA NA NA NA NA 6.5 NA NA NA NA 2.44 5.15 NA NA 2.6 NA 634.9 NA NA NA NA NA 4.84 23 376 28.0 2.25 NA 206 NA NA NA NA NA 30.1 41 NA NA NA NA NA NA NA 142.7 NA NA 30 74.7 88
1 NA NA 12.4 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 115 NA NA NA NA NA NA 3.16 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 16.3 NA NA 0.92 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.92 NA NA NA 38.9 NA NA NA NA NA NA NA NA
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -1 NA NA NA NA NA NA NA NA NA NA
# new_DF <- blood_cut[rowSums(is.na(blood_cut)) > 0,]
# 
# new_DF